home *** CD-ROM | disk | FTP | other *** search
/ HAKERIS 11 / HAKERIS 11.ISO / linux / system / LinuxConsole 0.4 / linuxconsole0.4install-en.iso / guile0.4.lcm / share / guile / 1.6.0 / scripts / punify < prev    next >
Encoding:
Text File  |  2004-01-06  |  3.0 KB  |  90 lines
  1. #!/bin/sh
  2. # aside from this initial boilerplate, this is actually -*- scheme -*- code
  3. main='(module-ref (resolve-module '\''(scripts punify)) '\'main')'
  4. exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
  5. !#
  6. ;;; punify --- Display Scheme code w/o unnecessary comments / whitespace
  7.  
  8. ;;     Copyright (C) 2001 Free Software Foundation, Inc.
  9. ;;
  10. ;; This program is free software; you can redistribute it and/or
  11. ;; modify it under the terms of the GNU General Public License as
  12. ;; published by the Free Software Foundation; either version 2, or
  13. ;; (at your option) any later version.
  14. ;;
  15. ;; This program is distributed in the hope that it will be useful,
  16. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  18. ;; General Public License for more details.
  19. ;;
  20. ;; You should have received a copy of the GNU General Public License
  21. ;; along with this software; see the file COPYING.  If not, write to
  22. ;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
  23. ;; Boston, MA 02111-1307 USA
  24.  
  25. ;;; Author: Thien-Thi Nguyen
  26.  
  27. ;;; Commentary:
  28.  
  29. ;; Usage: punify FILE1 FILE2 ...
  30. ;;
  31. ;; Each file's forms are read and written to stdout.
  32. ;; The effect is to remove comments and much non-essential whitespace.
  33. ;; This is useful when installing Scheme source to space-limited media.
  34. ;;
  35. ;; Example:
  36. ;; $ wc ./punify ; ./punify ./punify | wc
  37. ;;     89     384    3031 ./punify
  38. ;;      0      42     920
  39. ;;
  40. ;; TODO: Read from stdin.
  41. ;;       Handle vectors.
  42. ;;       Identifier punification.
  43.  
  44. ;;; Code:
  45.  
  46. (define-module (scripts punify)
  47.   :export (punify))
  48.  
  49. (define (write-punily form)
  50.   (cond ((and (list? form) (not (null? form)))
  51.          (let ((first (car form)))
  52.            (display "(")
  53.            (write-punily first)
  54.            (let loop ((ls (cdr form)) (last-was-list? (list? first)))
  55.              (if (null? ls)
  56.                  (display ")")
  57.                  (let* ((new-first (car ls))
  58.                         (this-is-list? (list? new-first)))
  59.                    (and (not last-was-list?)
  60.                         (not this-is-list?)
  61.                         (display " "))
  62.                    (write-punily new-first)
  63.                    (loop (cdr ls) this-is-list?))))))
  64.         ((and (symbol? form)
  65.               (let ((ls (string->list (symbol->string form))))
  66.                 (and (char=? (car ls) #\:)
  67.                      (not (memq #\space ls))
  68.                      (list->string (cdr ls)))))
  69.          => (lambda (symbol-name-after-colon)
  70.               (display #\:)
  71.               (display symbol-name-after-colon)))
  72.         (else (write form))))
  73.  
  74. (define (punify-one file)
  75.   (with-input-from-file file
  76.     (lambda ()
  77.       (let ((toke (lambda () (read (current-input-port)))))
  78.         (let loop ((form (toke)))
  79.           (or (eof-object? form)
  80.               (begin
  81.                 (write-punily form)
  82.                 (loop (toke)))))))))
  83.  
  84. (define (punify . args)
  85.   (for-each punify-one args))
  86.  
  87. (define main punify)
  88.  
  89. ;;; punify ends here
  90.